home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Precision Software Appli…tions Silver Collection 3
/
Precision Software Applications Silver Collection Volume Three (PSM) (1993).iso
/
music2
/
voc2sds.arj
/
VOC2SDS.BAS
next >
Wrap
BASIC Source File
|
1993-03-02
|
15KB
|
447 lines
'
' VOC2SDS by Monte Ferguson (C) Copyright 1993 Monte Ferguson
'
' Notes: This code was not written to be elegant or user friendly, or to be
' a tutorial on how to write good code - it was written to WORK the way *I*
' wanted it to.
'
' If you'd like to swipe the code or hack it, please feel free. I ask only
' that you send me a copy of anything you create with it - that would be my
' payment. Mention in your dox would be nice, too :-)
'
' Monte Ferguson
' 1250 Anita Drive #304
' Kent, OH 44240
' Fido: 1:157/200.39
'
' Enjoy.
'
' P.S. - hardcoded stuff that's easy to change is generally marked with
' <<< LOOK <<
' ie, channel numbers, sample number, etc.
DECLARE FUNCTION GetBlkLen! ()
DECLARE FUNCTION GenPath$ (FSpec$)
DECLARE FUNCTION GenSpec$ (FSpec$, DefExt$)
DECLARE FUNCTION SngToM3$ (n!)
DECLARE FUNCTION M3toDec! (m3$)
DECLARE FUNCTION Hx$ (Text$)
DEFINT A-Z
'
' VOC2SDS - Converts .VOC files to Sample Dump Standard
' Copyright 1993 Monte Ferguson
'
' First version 01-Mar-93
'
CONST Vers = "1.0"
CONST LastUpdate = "02-Mar-93"
CONST Copyright = "VOC2SDS Copyright 1993, Monte Ferguson"
CONST False = 0
CONST True = NOT False
TYPE VOCHeaderType
Des AS STRING * 20
BlockOffset AS INTEGER
Vers AS INTEGER
VerComp AS INTEGER
END TYPE
TYPE SDSHeaderType
f07e AS STRING * 2
Channel AS STRING * 1
One AS STRING * 1
SampleNum AS STRING * 2
Bits AS STRING * 1
Period AS STRING * 3
SLength AS STRING * 3
SustLoopStart AS STRING * 3
SustLoopEnd AS STRING * 3
LoopType AS STRING * 1
F7 AS STRING * 1
END TYPE
TYPE SDSBLockType
f07e AS STRING * 2
Channel AS STRING * 1
Two AS STRING * 1
PktCnt AS STRING * 1
DTA AS STRING * 120
ChkSum AS STRING * 1
F7 AS STRING * 1
END TYPE
DIM VocHead AS VOCHeaderType
DIM SDSHead AS SDSHeaderType
DIM SDSBLock AS SDSBLockType
FileSpec$ = GenSpec$(LTRIM$(UCASE$(COMMAND$)), "VOC")
PRINT Copyright
PRINT Vers + " " + LastUpdate
PRINT ""
IF LEN(FileSpec$) > 0 THEN
FPath$ = GenPath$(FileSpec$)
d$ = DIR$(FileSpec$)
DO WHILE d$ <> ""
KY$ = INKEY$
f$ = FPath$ + d$
PRINT ""
a$ = "------" + f$ + "------"
PRINT SPACE$(40 - LEN(a$) / 2) + a$
PRINT ""
' Examine the file
OPEN f$ FOR BINARY AS #1
GET #1, , VocHead
IF VocHead.Des <> "Creative Voice File" + CHR$(26) THEN
PRINT "Bogus header, not a .VOC file."
ELSE
v$ = HEX$(VocHead.Vers)
IF LEN(v$) < 4 THEN v$ = STRING$(4 - LEN(v$), "0") + v$
v$ = LTRIM$(STR$(VAL("&H" + LEFT$(v$, 2)))) + "." + LTRIM$(STR$(VAL("&H" + RIGHT$(v$, 2))))
PRINT "Version:"; v$
PRINT "Offset to 1st data block:"; VocHead.BlockOffset
SEEK #1, VocHead.BlockOffset + 1
BlockCount = 0
' 1 2 3 4 5 6 7 8
'12345678901234567890123456789012345678901234567890123456789012345678901234567890
'Blk Type Bytes Secs SmplRate Pack Other
'## \ \ #,###,### ###.# ##,### \ \ \ \
PRINT "Blk Type Bytes Secs SmplRate Pack Other"
PRINT STRING$(79, "-")
Converted = False
DO
BlockCount = BlockCount + 1
BType$ = SPACE$(1)
GET #1, , BType$
SELECT CASE ASC(BType$)
CASE 0
BType$ = "Terminator"
PRINT USING "## \ \ #,###,### ###.# ##,### \ \ \ \"; BlockCount; BType$; 0; 0; 0; "N/A"
EXIT DO
CASE 1
BL! = GetBlkLen
s! = SEEK(1)
BType$ = "Voice Data"
SR$ = SPACE$(1)
GET #1, , SR$
SR! = ASC(SR$)
SR! = INT(1000000! / (256 - SR!) + .5)
Secs! = INT((BL! / SR!) * 10) / 10
Pk$ = SPACE$(1)
GET #1, , Pk$
SELECT CASE ASC(Pk$)
CASE 0
PT$ = "Raw 8-bit"
CASE 1
PT$ = "4-bit"
CASE 2
PT$ = "2.6 bit"
CASE 3
PT$ = "2 bit"
CASE ELSE
PT$ = "Unknown!"
END SELECT
PRINT USING "## \ \ #,###,### ###.# ##,### \ \ \ \"; BlockCount; BType$; BL!; Secs!; SR!; PT$
IF Pk$ <> CHR$(0) THEN
PRINT " ---> PACKED BLOCK, CANNOT CONVERT!"
ELSE
IF NOT Converted THEN
PRINT " ---> Converting...";
Target$ = FPath$ + d$
p = LEN(Target$)
DO WHILE p >= 1
IF MID$(Target$, p, 1) = "." THEN
EXIT DO
END IF
p = p - 1
LOOP
IF p = 0 THEN
Target$ = Target$ + ".SDS"
ELSE
Target$ = LEFT$(Target$, p) + "SDS"
END IF
OPEN Target$ FOR BINARY AS #2
SDSHead.f07e = CHR$(&HF0) + CHR$(&H7E)
SDSHead.Channel = CHR$(0) ' <<<<<<<<<<<<<<<< LOOK <<<<<<
SDSHead.One = CHR$(1)
SDSHead.SampleNum = CHR$(0) + CHR$(0)' <<<<<<<<<<<<<<<< LOOK <<<<<<
SDSHead.Bits = CHR$(16) ' <<<<<<<<<<<<<<<< LOOK <<<<<<
SDSHead.Period = SngToM3$((1 / SR!) * 1000000000#)
SDSHead.SLength = SngToM3$(BL!)
SDSHead.SustLoopStart = SngToM3$(0)' <<<<<<<<<<<<<<<< LOOK <<<<<<
SDSHead.SustLoopEnd = SngToM3$(BL!)' <<<<<<<<<<<<<<<< LOOK <<<<<<
SDSHead.LoopType = CHR$(0) ' <<<<<<<<<<<<<<<< LOOK <<<<<<
SDSHead.F7 = CHR$(&HF7)
PUT #2, , SDSHead
' Now we create blocks by fetching 40 bytes of .VOC data
' at a shot. Since 16 bits takes 3 7-bit words, that gives
' us the correct 120 bytes/block length for SDS.
nb! = BL! / 40
IF nb! <> INT(nb!) THEN
nb! = INT(nb!) + 1
END IF
' Yes, this grunges the last block if it's not a multiple of
' 40 bytes. So sue me. I *told* you this was quick and dirty! :-)
FOR i = 1 TO nb!
Pkt = (i - 1) MOD 128' Packet Count
Smp$ = SPACE$(40)
GET #1, , Smp$
Chk = &H7E ' The running checksum
Chk = Chk XOR 0 ' Channel Num
Chk = Chk XOR 2 ' "Two"
Chk = Chk XOR Pkt
DTA$ = ""
FOR j = 1 TO LEN(Smp$)
Byte8 = ASC(MID$(Smp$, j, 1))
' This next line converts the 8-bit sample to 16 bits:
Byte16! = Byte8 * 256!
' And this stuff divides our 16 bits into three MIDI data bytes.
' The 1st bytes is 512s, the 2nd byte is 4 and the last bytes is the
' remainder (0-3) but LEFT JUSTIFIED within the 7-bit field. Hey, I
' didn't write the standard, I just live with it! :-)
b1 = INT(Byte16! / 512)
r1! = Byte16! - (b1 * 512!)
b2 = INT(r1! / 4)
r2! = r1! - (b2 * 4)
b3 = r2! * 32
Chk = Chk XOR b1
Chk = Chk XOR b2
Chk = Chk XOR b3
DTA$ = DTA$ + CHR$(b1) + CHR$(b2) + CHR$(b3)
NEXT j
SDSBLock.f07e = CHR$(&HF0) + CHR$(&H7E)
SDSBLock.Channel = CHR$(0) ' <<<<<<<< LOOK <<<<<<<<<<<<
SDSBLock.Two = CHR$(2)
SDSBLock.PktCnt = CHR$(Pkt)
SDSBLock.DTA = DTA$
SDSBLock.ChkSum = CHR$(Chk)
SDSBLock.F7 = CHR$(&HF7)
PUT #2, , SDSBLock
y = CSRLIN
x = POS(0)
PRINT INT((i / nb!) * 100); "%";
LOCATE y, x
NEXT i
CLOSE #2
PRINT "Done."
Converted = True
REM Stuff
ELSE
PRINT "(this version only converts the 1st block...)"
END IF
END IF
SEEK #1, s! + BL!
CASE 2
BL! = GetBlkLen
s! = SEEK(1)
BType$ = "Voice Continuation"
PRINT USING "## \ \ #,###,### ###.# ##,### \ \ \ \"; BlockCount; BType$; BL!; Secs!; SR!; PT$
SEEK #1, s! + BL!
CASE 3
BL! = GetBlkLen
s! = SEEK(1)
BType$ = "Silence"
Pr$ = SPACE$(2)
GET #1, , Pr$
Pr = CVI(Pr$)
SR$ = SPACE$(1)
GET #1, , SR$
SR! = ASC(SR$)
SR! = INT(1000000! / (256 - SR!) + .5)
Secs! = INT((Pr / SR!) * 10) / 10
PRINT USING "## \ \ #,###,### ###.# ##,### \ \ \ \"; BlockCount; BType$; BL!; Secs!; SR!; "N/A"
SEEK #1, s! + BL!
CASE 4
BL! = GetBlkLen
s! = SEEK(1)
BType$ = "Marker"
Pr$ = SPACE$(2)
GET #1, , Pr$
Pr = CVI(Pr$)
PRINT USING "## \ \ #,###,### ###.# ##,### \ \ \ \"; BlockCount; BType$; BL!; Secs!; SR!; "N/A"; "Marker=" + LTRIM$(STR$(Pr))
SEEK #1, s! + BL!
CASE 5
BL! = GetBlkLen
BType$ = "ASCII Text"
s! = SEEK(1)
Txt$ = SPACE$(BL!)
GET #1, , Txt$
PRINT USING "## \ \ #,###,### ###.# ##,### \ \ \ \"; BlockCount; BType$; BL!; 0; 0; "N/A"; "Text follows:"
PRINT SPACE$(4); Txt$
SEEK #1, s! + BL!
CASE 6
BL! = GetBlkLen
s! = SEEK(1)
BType$ = "Repeat"
Pr$ = SPACE$(2)
GET #1, , Pr$
Pr = CVI(Pr$)
IF Pr <> &HFFFF THEN
RP$ = "Repeat" + STR$(Pr) + " times."
ELSE
RP$ = "Repeat endlessly."
END IF
PRINT USING "## \ \ #,###,### ###.# ##,### \ \ \ \"; BlockCount; BType$; BL!; 0; 0; "N/A"; RP$
SEEK #1, s! + BL!
CASE 7
BL! = GetBlkLen
s! = SEEK(1)
BType$ = "End Repeat"
PRINT USING "## \ \ #,###,### ###.# ##,### \ \ \ \"; BlockCount; BType$; BL!; 0; 0; "N/A"
SEEK #1, s! + BL!
CASE ELSE
BL! = GetBlkLen
s! = SEEK(1)
BType$ = "UNKNOWN:" + LTRIM$(STR$(ASC(BType$)))
SR$ = SPACE$(1)
GET #1, , SR$
SR! = ASC(SR$)
SR! = INT(1000000! / (256 - SR!) + .5)
Secs! = INT((BL! / SR!) * 10) / 10
Pk$ = SPACE$(1)
GET #1, , Pk$
SELECT CASE ASC(Pk$)
CASE 0
PT$ = "Raw 8-bit"
CASE 1
PT$ = "4-bit"
CASE 2
PT$ = "2.6 bit"
CASE 3
PT$ = "2 bit"
CASE ELSE
PT$ = "Unknown!"
END SELECT
PRINT USING "## \ \ #,###,### ###.# ##,### \ \ \ \"; BlockCount; BType$; BL!; Secs!; SR!; PT$
SEEK #1, s! + BL!
END SELECT
IF BType$ = CHR$(0) OR KY$ = CHR$(27) THEN
EXIT DO
END IF
LOOP
END IF
CLOSE #1
PRINT ""
PRINT ""
IF KY$ = CHR$(27) THEN
EXIT DO
END IF
d$ = DIR$
LOOP
ELSE
PRINT "No files matching " + COMMAND$
PRINT ""
PRINT "VOC2SDS - a utility to convert .VOC files to Sample Dump Standard MIDIEx data."
PRINT "Copyright 1993 Monte Ferguson"
PRINT "Vers: "; Vers; ", Last Updated:"; LastUpdate
PRINT "Usage: VOC2SDS filespec"
PRINT ""
PRINT "filespec may contain wildcard characters, .VOC extension is assumed."
PRINT "Data is written to filename.SDS. Only 8-bit RAW blocks can be converted!"
PRINT "(and this version does only the 1st voice block)"
END IF
FUNCTION GenPath$ (FSpec$)
' Parses the path out of passed file spec (FSpec$)
p = LEN(FSpec$)
DO WHILE p > 0
IF INSTR("\:", MID$(FSpec$, p, 1)) > 0 THEN
EXIT DO
END IF
p = p - 1
LOOP
IF p > 0 THEN
GenPath$ = LEFT$(FSpec$, p)
ELSE
GenPath$ = ""
END IF
END FUNCTION
FUNCTION GenSpec$ (FSpec$, DefExt$)
REM --------------------------------------------------------------------
REM Given a filespec (FSpec$) and a default extension (DefExt$) try to
REM find some matching files
REM
REM
t$ = FSpec$ ' Temp work variable
REM Let's try as-is...
IF LEN(DIR$(t$)) = 0 THEN
' Ok, let's add the default extention...
IF RIGHT$(t$, 1) <> ":" THEN
' Keeps us from blowing up on "A:.TXT", etc
t$ = t$ + "." + DefExt$
END IF
IF LEN(DIR$(t$)) = 0 THEN
' Alright, let's do *.ext
t$ = FSpec$ + "*." + DefExt$
IF LEN(DIR$(t$)) = 0 THEN
' Last try... add a directory slash AND *.ext
t$ = FSpec$ + "\*." + DefExt$
IF LEN(DIR$(t$)) = 0 THEN
' I give up!
t$ = ""
END IF
END IF
END IF
END IF
GenSpec$ = t$
END FUNCTION
FUNCTION GetBlkLen!
a$ = SPACE$(3)
GET #1, , a$
l = ASC(a$)
M = ASC(MID$(a$, 2))
h = ASC(RIGHT$(a$, 1))
GetBlkLen! = h * 256! * 256! + M * 256! + l
END FUNCTION
FUNCTION Hx$ (Text$)
h$ = ""
FOR i = 1 TO LEN(Text$)
a = ASC(MID$(Text$, i, 1))
d$ = HEX$(a)
IF LEN(d$) < 2 THEN d$ = "0" + d$
IF LEN(h$) > 0 THEN
h$ = h$ + SPACE$(1)
END IF
h$ = h$ + d$
NEXT i
Hx$ = h$
END FUNCTION
FUNCTION M3toDec! (m3$)
IF LEN(m3$) <> 3 THEN STOP
m1 = ASC(MID$(m3$, 1))
m2! = ASC(MID$(m3$, 2)) * 128
m3! = ASC(MID$(m3$, 3)) * 16384!
M3toDec! = m1 + m2! + m3!
END FUNCTION
FUNCTION SngToM3$ (n!)
i1 = INT(n! / 16384!)
r! = n! - (i1 * 16384!)
i2 = INT(r! / 128)
i3 = r! - (i2 * 128)
SngToM3$ = CHR$(i3) + CHR$(i2) + CHR$(i1)
END FUNCTION